home *** CD-ROM | disk | FTP | other *** search
- # CVS $Id: toggleb.tcl,v 1.3 1995/02/03 16:55:28 zibi Exp $
-
- #
- # a minimal test of the toggle button widget
- #
-
- proc quitCB {form cbs} {
- VtClose
- }
-
- proc toggleChangedCB {cbs} {
- global label
-
- set wl [split [keylget cbs widget] .]
- set wi [expr "[llength $wl] - 1"]
- VtSetValues $label \
- -label "[lindex $wl $wi] Value: [keylget cbs set]"
- }
-
- proc nextToggle {name label value} {
- set tog [VtToggleButton $name -label $label -value $value \
- -callback toggleChangedCB \
- -CHARM_mnemonic [cindex $label 0] \
- -xmArgs "XmNbackground red"]
-
- return $tog
- }
-
- set fn [VtOpen "testtoggles"]
-
- set fn [VtFormDialog $fn.toggles -title "Toggles" \
- -xmArgs "XmNmarginWidth 10
- XmNmarginHeight 10
- XmNbackground green"]
-
- set rc1 [VtRowColumn $fn.rc1 -borderWidth 1]
-
- foreach i {1 2 3} {
- set tog [nextToggle $rc1.tog$i "$i Toggle" 0]
- }
-
- set form1 [VtForm $fn.form1 -borderWidth 2]
-
- foreach i {4 5 6} {
- set tog [nextToggle $form1.tog$i "Toggle $i" 1]
- }
-
- set label [VtLabel $fn.label -label "No Callback Yet" -below $form1]
-
- VtPushButton $fn.quit -callback "quitCB $fn" \
- -below $label \
- -leftSide FORM\
- -rightSide FORM\
- -topOffset 10\
- -leftOffset 5 \
- -rightOffset 5\
- -CHARM_topOffset 1\
- -CHARM_leftOffset 2\
- -CHARM_rightOffset 2
-
- VtShow $fn
- VtMainLoop
-
-